perm filename RHYTH.OLD[XX,LCS]1 blob sn#216134 filedate 1976-05-20 generic text, type T, neo UTF8
00100	C***** SUBRS RHYTH, SETUP, MARKS, DOTS  ********
00200	
00300		SUBROUTINE RHYTH
00400		DIMENSION R(10,80),POSNT(0/81)
00500		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
00600		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00700		COMMON /SCX/RHY(4),JALPHA(30),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
00800		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
00900		1 NFLG,IXX,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /FLM/RPOS(2,300)
01000		COMMON/ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01100		1 AVP2,ZX,RE,ZZ,RD,RSTX
01200	C   SEE ALSO FILLMS, SETLET AND SETUP  RE. /FLM/
01300		COMMON /POS/POS1,POS2 /STF/RSTFAC(-3/4),RSTJ3
01400		EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7),Z),(POSNT,RN(3801)),
01500		1(NTC,RN(3883)),(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
01600		1,(VX(8),C),(VX(9),S),(VX(10),X3),(RA,RN(3919)),(STEM,RN(2999))
01700		1,(R,RN(3001)),(STUP,RN(3921)),(PS2,RN(3922))
01800		1,(SET4,RN(3920)),(NOSET,RN(3923))
01900	CX	1,(POZ1,RN(3884))
02000	
02100		DATA FIB/.75/
02200	C  FIB IS FOR PSUEDO-FIBONACCI SPACING
02300		RSTJ3=RSTFAC(IFIX(STAFF))
02400		NX=-1
02500		JX=0
02600		NOTE=0
02700		Y=0
02800		NOSET=0
02900		JSET=0
03000	C  STUP IS NEG. IF SETUP IS NOT READY
03100		IF(STUP)GO TO 341
03200		IF(SET4.EQ.STAFF)NOSET=-1
03300	C  TO ADD MORE NOTES ON SETUP LINE. WIPES OUT P9 AT END OF SCMSS.
03400		KZ=1
03500		POS2=PS2
03600	C  GETS LAST ↑↑ POS. FROM SETUP
03700		JSET=-1
03800	C  NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
03900		DO 9 KX=1,100
04000	9	IF(RPOS(2,KX).GT.0)GO TO 10
04100	10	AVGPOS=RPOS(1,KX)
04200		RLPOS=AVGPOS
04300		KX=KX+1
04400		RLP2=RPOS(1,KX)
04500	343	AVP2=RPOS(2,KX)-.001
04600		IF(AVP2.GT.0)GO TO 341
04700		KX=KX+1
04800		GO TO 343
04900	C  AVERAGED AND REAL POSITIONS FROM 'SETUP'
05000	
05100	C  NEXT FOR NON-SETUP
05200	341	DO 34 K=1,IRHY
05300		Z=ABS(V(K))
05400	CC34	IF(V(K).GT..05)Y=ABS(V(K))+Y
05500	C  88TH NOTES ARE TAKEN AS GRACE NOTES. THEN BECOME 32NDS.
05600		IF(Z.NE.4./88.)GO TO 345
05700		IF(JSET)GO TO 34
05800	C  GRACE NOTES SKIPPED IN AUTOMATIC SETUP
05900	CF	Y=Y+.125
06000	CF	GO TO 34
06100	CF345	Y=ABS(V(K))+Y
06200	345	IF(STUP.LT.-1)Z=Z+(.125-Z)*FIB
06300	C  STUP CAN BE SET TO .LT.-1 IN NOTBMS FOR PSUEDO-FIBONACCI SPACE
06400		Y=Y+Z
06500	34	CONTINUE
06600	C  Y=TOTAL TIME
06700	CX	POZ1=POS1
06800	CX	POSNT(0)=POS2
06900	C A SAFEGUARD
07000	C  SAVES POS1 FOR POSITIONING MF, CRESC. ETC.
07100		NTC=0
07200	C  THE WORD COUNT FOR REAL NOTES.
07300		IF(JSET)GO TO 3421
07400	
07500		IF(POS1.LT.POS2)POSX=POS1
07600	C  SAVES IT FOR BACKUP
07700		IF(POS1.GE.POS2)POS1=POSX
07800	
07900		Z=POS2-POS1
08000		ZX=Z
08100	342	DO 1 K=1,IZ
08200		X=R(1,K)
08300		IF(X.LT.3.)GO TO 1
08400	C  JUMP IF NOTE OR REST
08500		IF(X.NE.17.)GO TO 8
08600	C   JUMP IF NOT A KEY SIG.
08700		RA=2.+ABS(R(5,K))*2.0
08800		GO TO 6
08900	8	IF(X.NE.4.)GO TO 81
09000	C   NEXT IS FOR BAR LINES
09100		RA=3
09200		J=K+1
09300		RE=R(1,J)
09400		IF(RE.EQ.3.)RA=1.5
09500	C  A CLEF
09600		IF(RE.EQ.18)RA=2.5
09700	C  A METER
09800		IF(RE.NE.1)GO TO 83
09900		IF(AMOD(R(5,J),10.).NE.0)RA=4.5
10000	C  FINDS ACCI ON NEXT NOTE.
10100	83	IF(K.EQ.IZ)RA=0
10200	C  END OF STAFF
10300		GO TO 6
10400	82	RA=6
10500		GO TO 83
10600	81	IF(X.EQ.18)GO TO 82
10700		RA=7.
10800	C   FOR CLEFS
10900		IF(K.LT.3)RA=9.
11000	C   THE FIRST CLEF IS NOT MINI
11100	6	RA=RA*RSTJ3
11200	C  SO SPACE WILL DEPEND ON SIZE OF STAFF
11300		Z=Z-RA
11400		R(8,K)=RA
11500	C   STORES SPACE NUM THAT MUST BE GIVEN BACK
11600	1	CONTINUE
11700	C   SUBTRACTS SPACE FOR CLEF OR BAR.  WILL ADD BOTH LATER.
11800	C  POS1 AND Z ARE FOR RHYTHMIC SPACING
11900	C  SPACE FOR NON-NOTES
12000	134	FORMAT(' **** MISMATCH WITH SPACING STAFF')
12100	3421	K=0
12200		IF(ABS(Y-RA).LE..001)GO TO 3
12300		IF(JSET)TYPE 134
12400	
12500	C   LOOP TO END
12600	3	K=K+1
12700	C   K IS COUNTER
12800		R(7,K)=0
12900		RE=R(1,K)
13000		IF(RE.LE.2.)GO TO 2
13100		RD=R(8,K)
13200		R(8,K)=0
13300		IF(JSET)GO TO 71
13400	
13500	7	IF(K.EQ.IZ)POS1=POS2
13600		IF(R(1,K-1).GT.2.)GO TO 73
13700		IF(K.EQ.1)GO TO 73
13800		IF(RE.EQ.4.)GO TO 73
13900		Z=Z+RD/3.
14000	C   RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
14100		POS1=POS1-RD/3
14200	C  THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
14300	73	R(3,K)=POS1
14400	72	POS1=POS1+RD
14500	C   ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
14600		GO TO 337
14700	
14800	C  40???   50????  WHY NOT 100?
14900	71	DO 74 J=KZ,80
15000	74	IF(RE.EQ.-RPOS(2,J))GO TO 75
15100		POS=R(3,K-1)+4
15200		GO TO 76
15300	75	POS=RPOS(1,J)
15400		KZ=J+1
15500	C  FOUND SAME TYPE OF ITEM.
15600	76	R(3,K)=POS
15700		GO TO 337
15800	
15900	2	JX=JX+1
16000	21	AB=V(JX)
16100		J=9
16200		IF(RE.NE.2)GO TO 121
16300		V(JX)=-AB
16400	C  SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
16500		J=7
16600	121	IF(R(8,K).GE.-1.)R(J,K)=AB
16700	C  STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
16800		IF(AB.GT..05)GO TO 210
16900	
17000		R(3,K)=-1.
17100	CC	RA=100
17200	CC	T=R(4,K)
17300	CC	IF(T)RA=-RA
17400	CC	R(4,K)=T+RA
17500		R(4,K)=R(4,K)+100.
17600	C  WILL THIS BE OK WITH NOTES BELOW B3 (I.E. NEG POSITIONS.
17700		R(7,K)=1
17800	C  FOUND A GRACE NOTE  (88TH NOTE)
17900		JZ=1
18000	
18100	1211	IF(R(8,K+JZ).GE.0)GO TO 211
18200		J=K+JZ
18300		R(3,J)=-1
18400	C  FOR AUTO-SPACING AT 337
18500		R(4,J)=R(4,J)+100.
18600	C MAKE IT A MINI-NOTE
18700		R(8,K)=1000.+ABS(R(4,K)-R(4,J))
18800	C  EXTEND THE STEM
18900		JZ=JZ+1
19000	C  FOR MORE CHORD NOTES.  SHOULD I CHECK FOR END (IZ)?
19100		GO TO 1211
19200	211	IF(JZ.GT.1)GO TO 2211
19300	C DON'T CHANGE STEM DIR. IF A CHORD
19400		R(8,K)=1000
19500	C  1000 IN P8 PUTS IN SLASH ON TAIL
19600		IF(STEM.GE.0)GO TO 2211
19700		RA=R(5,K)
19800		IF(RA.GE.20)R(5,K)=RA-10.
19900		IF(RA.LT.20)R(5,K)=RA+10.
20000	C  TURNS STEM OVER. UNLESS STEM DIRECTIONS WERE FIXED.(SU/SD/)
20100	2211	IF(JSET.GE.0)GO TO 3211
20200		K=K+JZ-1
20300	C  POS WILL BE SET AT 336
20400		NTC=NTC+1
20500	C  UPDATE THE COUNTER FOR IMPORTANT POSITIONS. POSNT SET AT 336
20600		POSNT(NTC)=-1
20700		GO TO 337
20800	3211	AB=.125
20900	C IT USED TO JUMP.  NOW MAKES SPACE FOR GRACE NOTES AS 32NDS.
21000	210	RB=0
21100	CC	IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB-1000.*R(8,K)
21200	C  FOR AUTOMATIC SETUP
21300		JZ=K
21400	C  JZ WILL BE USED NEAR END
21500	3634	IF(AMOD(AB,.1875).EQ.0)GO TO 122
21600		IF(AMOD(AB*10.,1.5).EQ.0)GO TO 122
21700	C  .1875 FINDS SINGLE DOTS ON NOTES (.15 FOR QUINTS) (*10 FOR ROUNDOFF!)
21800		IF(AMOD(AB,.4375).NE.0)GO TO 22
21900		T=20
22000		GO TO 322
22100	122	T=10
22200	322	IF(RE.EQ.2.)GO TO 35
22210		IF(R(6,K).LT.20)GO TO 422
22220		T=T+100
22225	C  TO SHIFT DOT DOWN 2 STEPS
22230	CC	IF(R(6,K).EQ.30)R(6,K)=0
22300	422	R(7,K)=T
22400	C  PUTS ONE OR TWO DOTS
22500		GO TO 36
22600	
22700	35	R(6,K)=T/10.
22800	C  ADDS DOT TO REST.
22900	36	RB=AB/3.
23000		IF(T.NE.1)RB=(4*AB)/7
23100	C  TO KEEP TAIL ON DOTTED NOTE
23200	
23300	22	POS=POS1
23400		IF(JSET.EQ.0)GO TO 220
23500	
23600	C  NEXT IS FOR SETUP
23700	222	IF(NOTE)GO TO 223
23800	C  FIRST TIME A NOTE IS FOUND.
23900		NOTE=-1
24000		POS1=RLPOS
24100		Z=POS2-POS1
24200	C  RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
24300	223	IF(POS1.LT.AVP2)GO TO 221
24400	224	KX=KX+1
24500	C???? OCT, 73	 	IF(NX.EQ.0)GO TO 225
24600		IF(NX)RLP2=RPOS(1,KX)
24700		NX=-1
24800	225	IF(RPOS(2,KX-1))GO TO 227
24900		RLPOS=RPOS(1,KX-1)
25000		AVGPOS=AVP2
25100	227	AVP2=RPOS(2,KX)-.001
25200		IF(AVP2.GT.0)GO TO 223
25300	C  0 IN RPOS=POS. OF NON-NOTE
25400	CC****** WHY NEEDED?? 6/74 ***	IF(RLP2.GE.POS1)NX=0
25500		NX=0
25600	CC*****↑↑↑↑ CHANGED FROM ABOVE ***  6/74
25700		GO TO 224
25800	221	POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
25900	220	R(3,K)=POS
26000	4634	IF(RE.NE.1)GO TO 44
26100		IF(POS.EQ.POSNT(NTC))GO TO 2634
26200	C  SKIPS OTHER CHORD NOTES.
26300		NTC=NTC+1
26400		POSNT(NTC)=POS
26500	C  SAVES IT FOR NUMBS ABOVE NOTES, ETC.
26600	2634	IF(AB.GE.2)GO TO 4
26700		IF(AB.EQ.1.333333333)GO TO 4
26800	44	L=K+1
26900		IF(R(8,L).GE.0)GO TO 1634
27000		IF(R(1,L).NE.1.)GO TO 1634
27100	C   JUMP IF NOT DOUBLE STOP
27200	C  DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
27300		R(3,L)=R(3,K)
27400		K=L
27500	CC	R(8,K)=0
27600		GO TO 3634
27700	C  LOOPS BACK TO PICK UP MORE CHORD NOTES
27800	
27900	C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
28000	4	RA=-R(6,K)
28100		IF(RA.EQ.0)RA=-1
28200		IF(AB.LT.4.)GO TO 144
28300		RP=1
28400		IF(AB.GE.8)RP=2
28500		R(7,K)=R(7,K)+RP
28600	C  +1=WHOLE NOTE WILL PRINT  +2=DBL WHL NT.
28700	CC NOT NEEDED BECAUSE OF ABOVE. 	RA=-2.
28800	144	R(6,K)=RA
28900		GO TO 44
29000	
29100	1634	T=POS1
29200		RP=AB
29300		IF(STUP.LT.-1)RP=AB+(.125-AB)*FIB
29400	C  FOR PSUEDO-FIB. SPACING
29500		POS1=RP/Y*Z+POS1
29600	CF	POS1=AB/Y*Z+POS1
29700	CZ	GO TO 1636
29800	CZ	IF(JSET)GO TO 1636
29900	CZ	RP=6.
30000	CZ	IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
30100	C  3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
30200	CZ	RA=POS1-T
30300	CZ	RSTX=RP*RSTJ3
30400	CZ	IF(RA.GT.RSTX)GO TO 1636
30500	C  JUMP IF NOTES ARE FAR ENOUGH APART
30600	CZ	RA=RSTX-RA
30700	C  THE DIFFERENCE
30800	CZ	Z=Z-Z*RA/(POS2-POS1)
30900	C  REDUCES TOTAL SIZE Z 
31000	CZ	POS1=T+RSTX
31050	1636	T=ABS(R(4,K))
31100		IF(T.LT.500.0.AND.T.GE.100.0)GO TO 337
31200	C  LEAVE TAILS ON GRACE NOTES ALONE. (NO SKIP WHEN IN MODE 500)
31300		T=0
31400		RA=AB-RB
31500		IF(RA.EQ.4./6.)GO TO 535
31600		IF(RA.EQ.4./7.)GO TO 535
31700		IF(RA.GT..75)GO TO 535
31800	C  KEEPS TAILS OFF TRIPLETS, QUINTS, SEPTS.
31900		DO 534 N=1,4
32000	534	IF(RA.LE.RHY(N))T=N
32100	C  DELETES STEM FROM WHOLE NOTES. (NOW DONE IN NOTWRT IF P7=1)
32200	535	IF(R(1,JZ).EQ.1.)GO TO 334
32300	CC	R(4,JZ)=0
32310		RA=R(4,JZ)
32400	C  SETS REST
32410		IF(R(8,JZ).NE.0.1)GO TO 537
32420		T=-4
32430		R(8,JZ)=-2
32435	C  -2 CENTERS THE SIGN UNDER THE RIGHT CONDITIONS
32440		GO TO 536
32500	537	IF(AB.LT.2)GO TO 536
32600		T=-1
32700		IF(AB.GE.4)T=-2
32800		IF(AB.GE.8)T=-3
32900	C  -1=HLF RST, -2=WHOLE, -3=DBL WHL RST, -4=REPEAT BAR SIGN(./.)
33000	C  WON'T DO DOUBLE DOTTED WHOLE NOTES.
33100	536	R(5,JZ)=T
33200		GO TO 337
33300	C*******  4/74  NEW WAY TO FIND TAILS
33400	C  OMITS RESTS  (REALLY???)
33500	334	R(7,JZ)=T+R(7,JZ)
33600	337	IF(K.LT.IZ)GO TO 3
33700		M=NTC
33800		DO 335 K=IZ,1,-1
33900		IF(R(3,K).GE.0)GO TO 335
34000		IF(K.NE.IZ)GO TO 336
34100		R(3,K)=POS2-4.
34200		GO TO 335
34300	336	N=K-1
34400	1336	RA=R(3,N)
34500		IF(RA.GT.0)GO TO 2336
34600		N=N-1
34700		IF(N.GT.0)GO TO 1336
34800	C GO BACK (IF MORE GRACE NOTES.) TO FIND PREVIOUS BIG NOTE.
34900	2336	T=R(3,K+1)
35000		RB=T-RA
35100		RA=4
35200		IF(RB.LE.4)RA=RB/3.
35300	C IF SPACE IS SMALL USE 1/3 OF IT.
35400		RB=T-RA
35500	C NEXT FOR GRACE NOTE CHORDS
35600		IF(R(8,K+1).GE.0)GO TO 1335
35700		RB=R(3,K+1)
35800		M=M+1
35900	1335	R(3,K)=RB
36000		POSNT(M)=RB
36100	335	M=M-1
36200		K=0
36300	45	K=K+1
36400	C  NEXT IS TO ARRANGE DOTS.
36500		IF(R(7,K).LT.10)GO TO 451
36600		RA=R(3,K)
36700		DO 452 M=K+1,IZ
36800		IF(R(3,M).NE.RA)GO TO 453
36900	C  JUMP IF NOT CHORD NOTE.
36910		T=R(7,M)
36920		RB=R(4,M)
37000		IF(T.LT.100.)GO TO 452
37100	C  JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
37200		IF(RB-R(4,M-1).NE.2)GO TO 452
37300		IF(AMOD(RB,2.).NE.0)R(7,M)=AMOD(T,10.)
37400	C  TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
37500	452	CONTINUE
37600	453	K=M-1
37700	451	IF(K.LT.IZ)GO TO 45
37800	
37900		N=IZ
38000		IF(JSET)GO TO 13
38100	13	NTC=NTC+1
38200		POSNT(NTC)=200
38300		POSNT(0)=0
38400		IF(IREAD)RETURN
38500		DIMENSION ISU(390)
38600		COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
38700		1 /POSI/STFF(-3/4),JJ2,POSQ /FRMT/FQZ(3),IREAD
38800		EQUIVALENCE (ISU,ST(3600)),(J5,JQ(2))
38900		CALL DPYSET(3,ISU,390)
40900		CALL DPYBRT(6)
41000		J2=STAFF
41100		POSQ=STFF(J2)
41200		J5=1
41300	CC	RA=-100
41400		R4=20
41500	C  R5=0=1  STANDARD SIZE IS USED.
41600		DO 131 K=1,NTC-1
41700	CC	IF(R(1,K).NE.1)GO TO 131
41800	CC	IF(R(3,K).EQ.RA)GO TO 131
41900	CC	RA=R(3,K)
42000	CC	R3=RHORZ(RA)
42100		R3=RHORZ(POSNT(K))
42200		CALL PNUM
42300	C  GOES TO DRAW A NUMBER OVER A NOTE
42400		J5=J5+1
42500		IF(J5.EQ.10)J5=0
42600	131	CONTINUE
42700	132	CALL DPYOUT(3)
42800		CALL SETPOG(1)
42900		END
43000	
43100	C  SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
43200		SUBROUTINE SETUP
43300		INTEGER PWDS
43400	      COMMON/FLM/RPOS(2,300) /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
43500		1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
43600		COMMON /PTR/PWDS(250),ITEM,L,I,IX
43700		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
43800		EQUIVALENCE (RA,RN(3919)),(ENDP,RN(3922)),(SETFLG,RN(3921))
43900		1,(SET4,RN(3920))
44000	
44100	C  RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
44200		SETFLG=-1
44300	C  THIS SENDS INFO TO SUBR. NOTES
44400		IF(SET4.GT.4)RETURN
44500	C  **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
44600		IF(ITEM.EQ.0)RETURN
44700		JX=0
44800	CC	RNL=0
44900		RA=0
45000		DO 9534 K=1,ITEM
45100		L=PWDS(K)
45200	      IF(RN(L+2).NE.SET4)GO TO 9534
45300		RD=RN(L+1)
45400		IF(RD.LT.5)GO TO 5
45500		IF(RD.LT.17)GO TO 9534
45600	5	IF(RD.GT.2)GO TO 6
45700		RC=7
45800		IF(RD.EQ.2)RC=5
45900		IF(RN(L).LT.RC)GO TO 9534
46000		M=9
46100		IF(RD.EQ.2)M=7
46200		IF(RN(L+M).EQ.0)GO TO 9534
46300	C  FOR OTHER NOTES ON SPACING STAFF.
46400		IF(RN(L+8).GT.999.)GO TO 9534
46500	C SKIPS MINI-NOTES. BUT TROUBLE IF STEMS CAUSE P8 TO BE ≤ 999.
46600		GO TO 7
46700	C  SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
46800	6	IF(RD.NE.3)GO TO 8
46900		IF(RN(L).LT.3)GO TO 7
46910		RC=RN(L+5)
46920		IF(RC.GE.100)GO TO 7
47000		IF(RC.GT.3)GO TO 9534
47100	C  SKIPS IF NOT A REAL CLEF  (+100=MINI CLEF)
47200		GO TO 7
47300	8	IF(RD.NE.4)GO TO 10
47400		IF(RN(L).GT.2)GO TO 9534
47500	C  SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
47600	10	IF(RD.NE.2)GO TO 7
47700		IF(RN(L).LT.5)GO TO 9534
47800		IF(RN(L+7).EQ.0)GO TO 9534
47900	7	JX=JX+1
48000		RPOS(1,JX)=RN(L+3)
48100		IF(RD.GT.2)GO TO 3
48200	C JUMP WHEN TIME VALUES ARE IN P8
48300		RC=RN(L+M)
48400	C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
48500	277	RA=RA+RC
48600	C  SUM OF RHYTHS
48700		GO TO 77
48800	3	RC=-RD
48900	77	RPOS(2,JX)=RC
49000	C  RC IS RHYTHMIC VALUE OF NOTE.
49100	9534	CONTINUE
49200	C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
49300	C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
49400		IF(RA.EQ.0)RETURN
49500	C  RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF. 
49600	
49700		CALL SORT2(RPOS,JX)
49800		ENDP=200.
49900		IF(RPOS(2,JX))ENDP=RPOS(1,JX)
50000		DO 1 L=1,JX
50100	1	IF(RPOS(2,L).GT.0)GO TO 4
50200	4	RD=RPOS(1,L)
50300		RB=ENDP-RD
50400	C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
50500		RC=RPOS(2,L)
50600		RPOS(2,L)=RD
50700	C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
50800		DO 2 K=L+1,JX
50900		RE=RPOS(2,K)
51000		IF(RE)GO TO 2
51100		RD=RC/RA*RB+RD
51200		RC=RE
51300		RPOS(2,K)=RD
51400	2	CONTINUE
51500	C  1,K=REAL POS.    2,K=AVERAGED POS.
51600	C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
51700		JX=JX+1
51800		RPOS(1,JX)=ENDP
51900		RPOS(2,JX)=ENDP
52000		SETFLG=0
52100	C  THIS FOR NOTES AND RHYTH
52200		END
52300	
52400		SUBROUTINE MARKS(RA)
52500		COMMON/ALF/INP(72),ML
52600		DIMENSION MKS(13)
52700		DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R'/
52800		EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
52900		1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10))
53000		RA=99
53100		DO 16 JM=1,72
53200	16	IF(INP(JM))GO TO 17
53300	C  DIDN'T FIND  MORE LETTERS
53400		RETURN
53500	17	N=INP(JM)
53600		ML=INP(JM+1)
53700		M=INP(JM+2)
53800		DO 1 K=1,13
53900	1	IF(N.EQ.MKS(K))GO TO 2
54000	C  DID NOT FIND A LETTER
54100		RETURN
54200	C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
54300	C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
54400	C 16=AR(SIS),17=MO(RDANT)
54500	C 18=I(NVRTD MORD), ---,20=TR(ILL), >39=PPP, PP, CRESC., ETC.
54600	C 21=HW (HEAVY WEDGE), 80=ACC(EL.)
54700	2	GO TO(120,10,12,120,4,11,15,15,15,21,12,80,81),K
54800	12	IF(ML.EQ.'L')GO TO 120
54900	C  ↑↑↑ PLUS
55000		IF(N.EQ.MF)GO TO 121
55100		RA=42
55200		IF(ML.NE.MP)GO TO 18
55300		RA=41
55400		IF(M.EQ.MP)RA=40
55500	C  FOR P, PP, PPP  -- 42, 41, 40
55600		GO TO 18
55700	15	IF(ML.EQ.MI)GO TO 82
55800		K=K+1
55850		IF(ML.EQ.MKS(1))K=18
55875	C 'HW' MAKES 21  (EVENTUALLY MAKES CLEF# 44)
55900	120	K=K+3
56000	8	RA=K
56100	C  YOU CAN TYPE # OR NAME OF MARK
56200	18	DO 6 JM=1,72
56300		N=INP(JM)
56400		INP(JM)=' '
56500	C  BLANKS OUT USED LETTERS
56600		IF(N.EQ.'/')RETURN
56700		IF(N.EQ.'*')RETURN
56800	6	IF(N.EQ.';')RETURN
56900	4	IF(ML.EQ.'O')GO TO 20
57000		RA=43
57100		IF(ML.EQ.MF)RA=50
57200	C  ↑↑↑↑↑ MP, MF
57300		GO TO 18
57400	121	IF(ML.EQ.'E')GO TO 120
57500	C  ↑↑↑  FERMATA
57600		RA=51
57700		IF(ML.NE.MF)GO TO 18
57800		RA=52
57900		IF(M.EQ.MF)RA=53
58000	C  F, FF, FFF  -- 51, 52, 53
58100		GO TO 18
58200	CC5	K=14
58300	CC	GO TO 8
58400	10	IF(ML.EQ.MC)GO TO 84
58500		IF(ML.NE.MR)GO TO 120
58600	19	K=13
58700	C  'R' FOR ARSIS
58800		GO TO 120
58900	11	IF(ML.EQ.MH)K=12
59000	C THESIS
59100		IF(ML.EQ.MR)K=17
59200		GO TO 120
59300	20	K=17
59400		GO TO 8
59500	21	K=18
59600		GO TO 8
59700	80	IF(ML.EQ.'+')GO TO 85
59800	C  FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
59900		IF(ML.EQ.'-')GO TO 86
60000		RA=70
60100	C  CRESC.
60200		GO TO 18
60300	85	RA=200
60400		GO TO 18
60500	86	RA=199
60600		GO TO 18
60700	81	RA=37
60800	C  RIT.
60900		GO TO 18
61000	82	RA=82
61100	C   DIM.
61200		GO TO 18
61300	84	RA=80
61400	C  ACCEL.
61500		GO TO 18
61600		END
61700	
61800	CC	NO LONGER CALLED          SUBROUTINE DOTS(L,Z,X,RC)
61900	C  M=BASIC RHY.  NX=NUM OF DOTS
62000	CC	COMMON /XRN/RN(4000)
62100	CC	RC=4./2.**(Z+2.)
62200	CC	IF(RN(L).LT.4)RETURN
62300	CC	IF(X.EQ.0)RETURN
62400	C -2=WHOLE, -1=HALF, 0=QUART, 1=EIGHTH, 2=SIXTEENTH, ETC.
62500	CC	B=RC
62600	CC	DO 100 NN=1,IFIX(X)
62700	CC	B=B/2
62800	CC100	RC=RC+B
62900	CC	END